home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Purity / Purity #48 (1995-06-25)(PackMAN)(DE)[WB].zip / Purity #48 (1995-06-25)(PackMAN)(DE)[WB].adf / Spiele / Buggers.p < prev    next >
Text File  |  1995-06-24  |  7KB  |  298 lines
  1. PROGRAM Buggers;
  2.  
  3. USES Crt;
  4.  
  5. TYPE
  6.         Feld        =    Array [1..5,1..5] OF INTEGER;
  7.         Farbfeld    =    Array [0..9] OF INTEGER;
  8.  
  9. VAR
  10.         sf: Feld;
  11.         f: Farbfeld;
  12.         zufallskeim,modulo,sgrad: INTEGER;
  13.  
  14.  
  15.  
  16. PROCEDURE GetInt(VAR int:INTEGER; VAR error:BOOLEAN);
  17.   VAR s: STRING[6];
  18.         wert,fehl: INTEGER;
  19.     BEGIN
  20.      READLN(s);
  21.      VAL(s,wert,fehl);
  22.      IF ((fehl>0) OR (s="") OR (s="+") OR (s="-")) THEN BEGIN
  23.       error:=TRUE;
  24.       wert:=0;
  25.      END ELSE error:=FALSE;
  26.      int:=wert;
  27. END;
  28.  
  29. FUNCTION Unfinished(vAR sf:Feld; modulo:Integer):Boolean;
  30.   VAR    h: Boolean;
  31.         i,j: Integer;
  32.     BEGIN
  33.      h:=FALSE;
  34.      FOR i:=1 TO 5 DO
  35.       FOR j:=1 TO 5 DO
  36.         IF sf[i,j]<>modulo THEN h:=TRUE;
  37.      Unfinished:=h;
  38. END;
  39.  
  40. PROCEDURE Addition(VAR sf:Feld; x,y,modulo: Integer);
  41.   VAR i: Integer;
  42.     BEGIN
  43.      FOR i:=1 TO 5 DO BEGIN
  44.       sf[x,i]:=(sf[x,i]+1) MOD (modulo+1);
  45.       IF i<>x THEN sf[i,y]:=(sf[i,y]+1) MOD (modulo+1);
  46.      END;
  47. END;
  48.  
  49. PROCEDURE Subtraktion(VAR sf:Feld; x,y,modulo:INTEGER);
  50.   VAR    i: INTEGER;
  51.     BEGIN
  52.      FOR i:=1 TO 5 DO BEGIN
  53.       sf[x,i]:=sf[x,i]-1;
  54.       IF sf[x,i]<0 THEN sf[x,i]:=modulo;
  55.       IF i<>x THEN BEGIN
  56.         sf[i,y]:=sf[i,y]-1;
  57.         IF sf[i,y]<0 THEN sf[i,y]:=modulo;
  58.       END;
  59.      END;
  60. END;
  61.  
  62. PROCEDURE BuggersIntro(VAR keim,sgrad,modulo:INTEGER);
  63.   VAR    i: INTEGER;
  64.         fehl: BOOLEAN;
  65.     BEGIN
  66.      ClrScr;
  67.      GOTOXY(1,6);
  68.      WRITELN("Willkommen bei Buggers!");
  69.      WRITELN;
  70.      WRITELN("Ziel des Spiels ist  es, alle Felder");
  71.      WRITELN("auf den  höchsten  Wert  zu  setzen.");
  72.      WRITELN("Dazu geben Sie eine Zeile und Spalte");
  73.      WRITELN("an, deren Felder dann um eins erhöht");
  74.      WRITELN("werden.Wird über das Maximum erhöht,");
  75.      WRITELN("so wird der Wert Null angenommen. Es");
  76.      WRITELN("gibt die Möglichkeit, ein Spiel vor-");
  77.      WRITELN("zeitig zu beenden, sowie den letzten");
  78.      WRITELN("Zug   rückgängig   zu   machen.  Der");
  79.      WRITELN("Schwierigkeitsgrad gibt die Zahl der");
  80.      WRITELN("mindestens benötigten Züge an.");
  81.      GOTOXY(40,7);
  82.       WRITE("|=================|");
  83.      GOTOXY(40,8);
  84.      WRITE("|  B U G G E R S  |");
  85.      GOTOXY(40,9);
  86.      WRITE("|=================|");
  87.      GOTOXY(40,11);
  88.       WRITE("© 1990");
  89.      GOTOXY(40,12);
  90.      WRITE("von Stephan Körting");
  91.      GOTOXY(40,13);
  92.      WRITE("adapted and converted by Sebastian Erbert");
  93.      fehl:=TRUE;
  94.      keim:=0;
  95.      WHILE fehl DO BEGIN
  96.       GOTOXY(10,20);
  97.       WRITE("Geben sie bitte eine beliebige Zahl ein: ");
  98.       GetInt(keim,fehl);
  99.       GOTOXY(10,20);
  100.       WRITE("                                                ");
  101.      END;
  102.      fehl:=TRUE;
  103.      WHILE fehl DO BEGIN
  104.       GOTOXY(10,20);
  105.       WRITE("Geben Sie bitte den Schwierigkeitsgrad ein: ");
  106.       GetInt(sgrad,fehl);
  107.       GOTOXY(10,20);
  108.       WRITE("                                                ");
  109.      END;
  110.      fehl:=TRUE;
  111.      modulo:=0;
  112.      WHILE (fehl OR (modulo>9) OR (modulo<1)) DO BEGIN
  113.       GOTOXY(10,20);
  114.       WRITE("Geben Sie bitte die höchste Ziffer ein: ");
  115.       GetInt(modulo,fehl);
  116.       GOTOXY(10,20);
  117.       WRITE("                                                ");
  118.      END;
  119.      FOR i:=6 TO 18 DO BEGIN
  120.       GOTOXY(1,i);
  121.       WRITE("                                      ");
  122.      END;
  123.      FOR i:=0 TO modulo DO f[i]:=i+5;
  124. END;
  125.  
  126. PROCEDURE InitSpielfeld(VAR sf:feld; modulo:INTEGER);
  127.   VAR    i,j: INTEGER;
  128.     BEGIN
  129.      FOR i:=1 TO 5 DO
  130.       FOR j:=1 TO 5 DO sf[i,j]:=modulo;
  131. END;
  132.  
  133. PROCEDURE ZerhackeSpielfeld(VAR sf:Feld; sg,zuf,modulo: INTEGER);
  134.  CONST    ug = 1;
  135.             og = 5;
  136.   VAR    i,x,y: INTEGER;
  137.  
  138.  FUNCTION Zufall(VAR keim:INTEGER; ug,og:INTEGER):INTEGER;
  139.   CONST    m = 2345;
  140.             f = 3;
  141.             ink = 7227;
  142.     VAR    h: INTEGER;
  143.      BEGIN
  144.       keim:=(f*keim+ink) MOD m;
  145.       h:=TRUNC((keim/m)*(og-ug+1)+ug);
  146.       IF h<ug THEN h:=ug;
  147.       IF h>og THEN h:=og;
  148.       Zufall:=h;
  149.  END;
  150.  
  151.     BEGIN        {  procedure main  }
  152.      FOR i:=1 TO sg DO BEGIN
  153.       x:=Zufall(zuf,ug,og);
  154.       y:=Zufall(zuf,ug,og);
  155.       Subtraktion(sf,x,y,modulo);
  156.      END;
  157. END;
  158.  
  159. PROCEDURE ZeigeSpielfeld(sf:Feld);
  160.   VAR    i,j: INTEGER;
  161.     BEGIN
  162.      GOTOXY(1,6);
  163.      WRITELN("         ");
  164.      FOR j:=1 TO 5 DO BEGIN
  165.       WRITE("         ");
  166.       FOR i:=1 TO 5 DO BEGIN
  167.         WRITE(" ");
  168.         WRITE(sf[i,j]:2);
  169.       END;
  170.       WRITELN(" ");
  171.       IF j<5 THEN WRITELN("         ")
  172.       ELSE WRITELN("         ");
  173.      END;
  174. END;
  175.  
  176. PROCEDURE Spiele(VAR sf:Feld; sg,modulo:Integer);
  177.   VAR    x,y,xneu,yneu: Integer;
  178.         fehler: Boolean;
  179.         zug,zugmax: Integer;
  180.         wahl: Char;
  181.     BEGIN
  182.      zugmax:=2*sg;
  183.      zug:=1;
  184.      GOTOXY(40,14);
  185.      WRITE("          GRAD: ",sgrad:3);
  186.      WHILE (Unfinished(sf,modulo) AND (zug<=zugmax)) DO BEGIN
  187.       GOTOXY(40,14);
  188.       WRITE("ZUG: ",zug:3);
  189.       GOTOXY(10,20);
  190.       WRITE("                                                     ");
  191.       GOTOXY(10,21);
  192.       WRITE("                                                     ");
  193.       GOTOXY(10,20);
  194.       WRITE("???  [+] - Ziehen  [R] - Zurücknehmen  [A] - Abbruch  ???  ");
  195.       REPEAT
  196.       UNTIL Keypressed;
  197.       wahl:=Readkey;
  198.       GOTOXY(10,20);
  199.       WRITE("                                                           ");
  200.       CASE wahl OF
  201.         "+": BEGIN
  202.                 fehler:=TRUE;
  203.                 WHILE fehler DO BEGIN
  204.                  GOTOXY(10,20);
  205.                  WRITE("                                                    ");
  206.                  GOTOXY(10,20);
  207.                  WRITE("Geben Sie bitte die Zeile ein: ");
  208.                  GetInt(yneu,fehler);
  209.                 END;
  210.                 IF ((0<yneu) AND (yneu<6)) THEN BEGIN
  211.                  fehler:=TRUE;
  212.                  WHILE fehler DO BEGIN
  213.                   GOTOXY(10,21);
  214.                   WRITE("                                                   ");
  215.                   GOTOXY(10,21);
  216.                   WRITE("Geben Sie bitte die Spalte ein: ");
  217.                   GetInt(xneu,fehler);
  218.                  END;
  219.                  IF ((0<xneu) AND (xneu<6)) THEN BEGIN
  220.                   x:=xneu;
  221.                   y:=yneu;
  222.                   Addition(sf,x,y,modulo);
  223.                   zug:=Succ(zug);
  224.                  END ELSE BEGIN
  225.                   GOTOXY(10,21);
  226.                   WRITE("Ihre Eingabe muß im Bereich von 1 bis 5 liegen !    {TASTE]");
  227.                   Waitforkey;
  228.                   GOTOXY(10,21);
  229.                   WRITE("                                                            ");
  230.                  END;  
  231.                 END ELSE BEGIN
  232.                  GOTOXY(10,20);
  233.                  WRITE("Ihre Eingabe muß im Bereich von 1 bis 5 liegen !    [TASTE]");
  234.                  Waitforkey;
  235.                  GOTOXY(10,20);
  236.                  WRITE("                                                            ");
  237.                 END;  
  238.               END;
  239.         "r","R": IF ((zug>1) AND (x<>-1)) THEN BEGIN
  240.                       Subtraktion(sf,x,y,modulo);
  241.                       Dec(zug);
  242.                       x:=-1;
  243.                      END ELSE BEGIN
  244.                       GOTOXY(10,20);
  245.                       WRITE("Leider geht das jetzt nicht !    [TASTE]");
  246.                       Waitforkey;
  247.                      END;
  248.         "a","A": BEGIN
  249.                       GOTOXY(10,20);
  250.                       WRITE("Wollen Sie diese Partie wirklich abbrechen (J/N) ?");
  251.                       READLN(wahl);
  252.                       IF ((wahl="j") OR (Wahl="J")) THEN zug:=zugmax+1;
  253.                      END;
  254.         OTHERWISE;
  255.       END;
  256.       ZeigeSpielfeld(sf);
  257.      END;
  258. END;
  259.  
  260. FUNCTION Auswertung(sf:Feld; modulo:Integer):Boolean;
  261.   VAR    h: Boolean;
  262.         antwort: Char;
  263.     BEGIN
  264.      GOTOXY(10,20);
  265.      WRITE("                                                   ");
  266.      GOTOXY(10,21);
  267.      WRITE("                                                   ");
  268.      GOTOXY(10,20);
  269.      IF Unfinished(sf,modulo) THEN
  270.       WRITE("Schade, aber vielleicht haben Sie das nächste Mal mehr Glück !")
  271.      ELSE WRITE("Herzlichen Glückwunsch");
  272.      GOTOXY(10,21);
  273.      WRITE("Möchten Sie noch eine Partie spielen (J/N) ? ");
  274.      READLN(antwort);
  275.      IF ((antwort="j") OR (antwort="J")) THEN h:=TRUE ELSE h:=FALSE;
  276.      GOTOXY(10,21);
  277.      WRITE("                                                                 ");
  278.      Auswertung:=h;
  279. END;
  280.  
  281.  
  282.  
  283. BEGIN        {  main  }
  284.  
  285.     REPEAT
  286.      BuggersIntro(zufallskeim,sgrad,modulo);
  287.      InitSpielfeld(sf,modulo);
  288.      ZerhackeSpielfeld(sf,sgrad,zufallskeim,modulo);
  289.      ZeigeSpielfeld(sf);
  290.      Spiele(sf,sgrad,modulo);
  291.     UNTIL NOT Auswertung(sf,modulo);
  292.     GOTOXY(10,23);
  293.     WRITELN("Auf Wiedersehen !");
  294.     Delay(1*50);
  295.     ClrScr;
  296. END.
  297.  
  298.